00100	COMMENT ⊗   VALID 00010 PAGES
00200	C REC  PAGE   DESCRIPTION
00300	C00001 00001
00400	C00002 00002	TITLE X
00500	C00003 00003	BEG:	SETOM LINE
00600	C00009 00004	MAIN:	0
00700	C00010 00005		AOJ A,
00800	C00011 00006	FRD:	MOVSI A,'DMD'
00900	C00012 00007	GETNAM:	MOVEI A,
01000	C00013 00008	XINI:	OUTSTR [ASCIZ /TOTAL LENGTH IN INCHES (Y DIMENSION, DEFAULT = 11)?/]
01100	C00016 00009	XGPOUT:	OPEN XGP,[1017↔'XGP   '↔0]
01200	C00019 00010	FILNAM:	0
01300	C00020 ENDMK
01400	C⊗;
     

00100	TITLE X
00200	
00300	A←1
00400	B←2
00500	C←3
00600	D←4
00700	E←5
00800	L←6
00900	U←7
01000	PEN←10
01100	X←11
01200	Y←12
01300	XD←13
01400	T←15
01500	TT←16
01600	P←17
01700	
01800	LPDL←←69
01900	
02000	DSK←←1
02100	XGP←←2
02200	
02300	LMAR←←=0
02400	RMAR←←=1699
02500	WIDTH←←=1700
02600	LBUFL←←=48
02700	LSTBIT←←1⊗34
02800	OVERLAP←←=50			;OVERLAP 1/4 INCH
02900	BOTTOM←←=50			;SHIFT BOTTOM UP 1/4 INCH
03000	
03100	DOFF←←-=760
03200	
03300	NBUFS←←4
03400	
03500	EXTERN JOBREL,JOBFF
03600	
03700	MAILBF:	BLOCK 40
03800	
03900	SIGN:	0
04000	LINE:	0
04100	PNTR:	0
     

00100	BEG:	SETOM LINE
00200		GETLIN LINE		;FOR ERROR PRINTOUT
00300	MERGE:	CALLI
00400		HRRZS LINE		;CLEAR LINE BITS
00500		MOVE P,[-LPDL,,PDL-1]
00600	FILIN:	OUTSTR [ASCIZ /FILE? (DEFAULT IS PLT.DMD) /]
00700		PUSHJ P,FRD
00800		SETZ A,
00900	YAGN1:	MOVE B,[-BOTTOM]
01000	OUTSTR [ASCIZ/ORIGIN X OFFSET FROM SIDE (DEFAULT IS 4(CENTER))?/]
01100		PUSHJ P,RNUM
01200		JRST [	MOVE A,[DOFF]
01300			JRST YDEF]
01400		IMULI A,=100
01500		CAIN C,"."		;DECIMAL POINT?
01600		JRST [	INCHWL C
01700			CAIN C,15
01800			INCHWL C
01900			CAIL C,"0"
02000			CAILE C,"9"
02100			JRST .+1
02200			SUBI C,60
02300			IMULI C,=10
02400			SKIPE SIGN
02500			MOVN C,C
02600			ADD A,C
02700			PUSH P,A
02800			PUSHJ P,RNUM	;JUST GOBBLE THE REST
02900			JFCL
03000			POP P,A
03100			JRST .+1]
03200		MOVN A,A
03300		LSH A,1			;*2 (MAKE IT STEPS)
03400	YDEFP:	CAIE C,12
03500		JRST [	CLRBFI
03600			JRST YAGN1]
03700	YDEF:	ADD A,B
03800		MOVNM A,INIX#
03900	AGAIN:	MOVE A,[FILNAM,,LKENT]
04000		BLT A,LKENT+3
04100		OPEN DSK,[14↔'DSK   '↔IBUF]
04200		JRST 4,.
04300		INBUF DSK,NBUFS
04400		LOOKUP DSK,LKENT
04500		JRST FNF
04600	ASKLEN:	SETZM POOB#
04700		PUSHJ P,XINI
04800		JRST CORLUZ
04900		SETZM XX#
05000		SETZM YY#
05100		SETZM PENN#
05200	OUTER:	IN DSK,
05300		JRST PLOT
05400		STATO DSK,20000
05500		JRST 4,.
05600		RELEAS DSK,
05700	IFN LSTBIT-1,<PUSHJ P,XFIX>
05800		JRST XGPOUT
05900	
06000	PENUP:	JRST @MAIN
06100	PLOT:	HRR 14,IBUF+1
06200		MOVN E,1(14)
06300		MOVSI E,(E)
06400		HRR E,IBUF+1
06500	PLOT1:	MOVE 14,2(E)
06600		JUMPE 14,ENOUT
06700		LSHC 14,-14
06800		ASH 15,-30
06900		MOVEM 15,SVPEN#
07000		MOVM D,15
07100		LSHC 14,-14
07200		ASH 15,-30
07300		MOVEM 15,SVY#
07400		MOVE C,15
07500		LSHC 14,-14
07600		ASH 15,-30
07700		MOVEM 15,SVX#
07800		CAIN D,1
07900		JRST PENOK
08000		SUBI D,3
08100		CAMN D,PENN
08200		JRST PENOK
08300		MOVE PEN,PENUP
08400		SKIPGE D
08500		MOVE PEN,[CAIGE Y,(L)]
08600	PENOK:	MOVEM D,PENN
08700		SUB 15,XX
08800		SKIPG 15
08900		MOVEI 16,4
09000		SKIPL 15
09100		MOVEI 16,10
09200		SUB C,YY
09300		SKIPG C
09400		MOVEI 0,0
09500		SKIPL C
09600		MOVEI 0,2
09700		MOVMS C
09800		MOVMS 15
09900		CAMG C,15
10000		JRST NOEX
10100		EXCH C,15
10200		EXCH 0,16
10300	NOEX:	JUMPE 15,NOMOVE
10400		JUMPE C,NORM
10500		SETZ 14,
10600		TLNE C,200000
10700		JRST .+4
10800		LSH C,1
10900		TRO C,1
11000		AOJA 14,.-4
11100		SUBI 14,=34
11200		IDIV C,15
11300		MOVNS 14
11400		LSH C,(14)
11500		SETZ 14,
11600	INLOOP:	ADD 14,C
11700		MOVE D,16
11800		TLZN 14,200000
11900		JRST OVA
12000		EXCH PEN,PENUP
12100		JSR MAIN
12200		EXCH PEN,PENUP
12300		MOVE D,0
12400	OVA:	JSR MAIN
12500		SOJG 15,INLOOP
12600		JRST .+4
12700	NORM:	MOVE D,16
12800	NORML:	JSR MAIN
12900		SOJG 15,NORML
13000		MOVE 4,SVX
13100		MOVEM 4,XX
13200		MOVE 4,SVY
13300		MOVEM 4,YY
13400	NOMOVE:	SKIPL SVPEN
13500		JRST ENOUT
13600		SETZM XX
13700		SETZM YY
13800	ENOUT:	AOBJN E,PLOT1
13900		JRST OUTER
14000	
14100	
14200	FNF:	PUSHJ P,DETCHK
14300		PUSHJ P,XERR
14400		PUSHJ P,ERRPNT
14500		ASCIZ /LOOKUP FAILED.
14600	/
14700		SKIPGE DET
14800		CALLI 12
14900		JRST FILIN
15000	
15100	CORLUZ:	MOVE T,TT
15200		LSH T,-12
15300		PUSH P,T
15400		PUSHJ P,DETCHK
15500		PUSHJ P,XERR
15600		POP P,T
15700		PUSHJ P,DECOUT
15800		PUSHJ P,ERRPNT
15900		ASCIZ / K OF CORE NEEDED!
16000	/
16100		SKIPGE DET
16200		CALLI 12
16300		JRST ASKLEN
16400	
16500	LOSE:	SKIPN POOB
16600		TLNN PEN,400000
16700		JRST @MAIN
16800		SETOM POOB
16900		PUSHJ P,DETCHK
17000		PUSHJ P,XERR
17100		PUSHJ P,ERRPNT
17200		ASCIZ /POINT OUT OF BOUNDS, /
17300		CAIGE Y,(L)
17400		JRST [	PUSHJ P,ERRPNT
17500			ASCIZ/-Y/
17600			JRST BACTT]
17700		PUSHJ P,ERRPNT
17800		ASCIZ/+Y/
17900	BACTT:	MOVE TT,SVTT#
18000		JRST @MAIN
18100	
18200	DECOUT:	IDIVI T,=10
18300		HRLM TT,(P)
18400		SKIPE T
18500		PUSHJ P,DECOUT
18600		HLRZ TT,(P)
18700		ADDI TT,60
18800		ROT TT,-7
18900		MOVEM TT,.+2
19000		PUSHJ P,ERRPNT
19100		0
19200		POPJ P,
19300	
19400	ERRPNT:	MOVEM TT,SVTT
19500		HRRZ TT,(P)
19600		MOVEM TT,PNTR
19700		MOVEI TT,LINE
19800		TTYMES TT,
19900		JRST [	OUTSTR[ASCIZ/TTYMES FAILED	/]
20000			OUTSTR @PNTR
20100			OUTSTR[ASCIZ/
20200	/]
20300			JRST .+1]
20400		POP P,TT
20500		HRL TT,(TT)
20600		TLNE TT,376
20700		AOJA TT,.-2
20800		JRST 1(TT)
20900	
21000	XERR:	PUSHJ P,ERRPNT
21100		ASCIZ/
21200	MESSAGE FROM X WORKING ON /
21300		MOVE TT,FILNAM
21400		PUSHJ P,SIXOUT
21500		PUSHJ P,ERRPNT
21600		ASCIZ/./
21700		HLLZ TT,FILEXT
21800		PUSHJ P,SIXOUT
21900		PUSHJ P,ERRPNT
22000		ASCIZ/[/
22100		MOVE TT,FILPPN
22200		PUSHJ P,SIXOUT
22300		PUSHJ P,ERRPNT
22400		ASCIZ/] : /
22500		POPJ P,
22600	
22700	SIXOUT:	JUMPE TT,CPOPJ
22800		SETZ T,
22900		LSHC T,6
23000		ADDI T,40
23100		PUSH P,TT
23200		ROT T,-7
23300		MOVEM T,.+2
23400		PUSHJ P,ERRPNT
23500		0
23600		POP P,TT
23700		JRST SIXOUT
23800	
23900	DETCHK:	SETOM DET#
24000		GETLIN DET
24100		HRRES DET
24200		SKIPL DET
24300		AOS (P)
24400		POPJ P,
     

00100	MAIN:	0
00200		JRST MVDWN(D)
00300	MVDWN:	SUBI Y,LBUFL+1
00400		JRST DOPEN
00500	MVUP:	ADDI Y,LBUFL+1
00600		JRST DOPEN
00700	MVLFT:	ROT B,-1
00800		JUMPGE B,DOPEN
00900		XCT XMOVR(X)
01000		JRST DOPEN
01100	MVRT:	SKIPGE B
01200		XCT XMOVL(X)
01300	DOI3:	ROT B,1
01400	DOPEN:	XCT PEN
01500		JRST LOSE
01600		CAIL Y,-LBUFL-1(U)
01700		JRST LOSE
01800		IORM B,@X
01900		JRST @MAIN
02000	
     

00100		AOJ A,
00200	XMOVL:	HRLOI X,XD
00300		REPEAT LBUFL-1,<SOJ X,>
00400		SOJL A,.+1
00500		MOVE X,[Y,,LBUFL-1]
00600		AOJA A,DOI3
00700	
00800		SOJL A,XONR
00900	XMOVR:	REPEAT LBUFL-1,<AOJ X,>
01000		MOVE X,[XD,,LBUFL]
01100		AOJ A,
01200	
01300	XONR:	MOVSI X,Y
01400		AOJA A,DOPEN
     

00100	FRD:	MOVSI A,'DMD'
00200		MOVEM A,FILEXT
00300		PUSHJ P,GETNAM
00400		SKIPN A
00500	 	MOVE A,['PLT   ']
00600	    	MOVEM A,FILNAM
00700		CAIE C,"."
00800		JRST NOEXT
00900		PUSHJ P,GETNAM
01000		MOVEM A,FILEXT
01100	NOEXT:	CAIE C,"["
01200		JRST FRDX
01300		PUSHJ P,GETP
01400		HRLZM A,FILPPN
01500		PUSHJ P,GETP
01600		HRRM A,FILPPN
01700	FRDX:	INCHRW C
01800		CAIE C,12
01900		JRST FRDX
02000		POPJ P,
02100	
02200	RNUM:	INCHWL C
02300		CAIN C,15
02400		JRST RNUM
02500		CAIN C,12
02600		POPJ P,
02700		AOS (P)
02800		MOVEI A,
02900		SETZM SIGN
03000		CAIN C,"-"
03100		JRST [	PUSHJ P,RNUML
03200			SETOM SIGN
03300			MOVN A,A
03400			POPJ P,]
03500		CAIN C,"+"
03600	RNUML:	INCHWL C
03700		CAIL C,"0"
03800		CAILE C,"9"
03900		JRST RNUMX
04000		IMULI A,12
04100		ADDI A,-"0"(C)
04200		JRST RNUML
04300	
04400	RNUMX:	CAIN C,15
04500		INCHRW C
04600		POPJ P,
     

00100	GETNAM:	MOVEI A,
00200		MOVE B,[440600,,A]
00300	GETNML:	PUSHJ P,RCH
00400		POPJ P,
00500		SUBI C,40
00600		TLNE B,770000
00700		IDPB C,B
00800		JRST GETNML
00900	
01000	GETP:	MOVEI A,
01100	GETPL:	PUSHJ P,RCH
01200		POPJ P,
01300		TRNE A,770000
01400		JRST GETPL
01500		LSH A,6
01600		ADDI A,-40(C)
01700		JRST GETPL
01800	
01900	RCH:	INCHWL C
02000		CAIN C,42
02100		JRST RCHQ
02200		CAIE C,11
02300		CAIN C," "
02400		JRST RCH
02500		CAIE C,"."
02600		CAIN C,","
02700		POPJ P,
02800		CAIE C,"["
02900		CAIN C,"]"
03000		POPJ P,
03100	RCHQR:	CAIGE C,40
03200		POPJ P,
03300		CAIL C,"a"
03400		CAILE C,"z"
03500		CAIA
03600		SUBI C,40
03700		JRST POPJ1
03800	
03900	RCHQ:	INCHWL C
04000		JRST RCHQR
     

00100	XINI:	OUTSTR [ASCIZ /TOTAL LENGTH IN INCHES (Y DIMENSION, DEFAULT = 11)?/]
00200		PUSHJ P,RNUM
00300		MOVEI A,=11		;ASSUME 11 INCHES
00400		JUMPLE A,[XINLER:CLRBFI
00500			JRST XINI]
00600		CAIE C,12
00700		JRST XINLER
00800		IMULI A,=200
00900		PUSH P,A		;SAVE THIS
01000	YINI1:	OUTSTR [ASCIZ \ORIGIN Y OFFSET FROM BOTTOM, 200/IN.(DEFAULT IS 100)?\]
01100		PUSHJ P,RNUM
01200		JRST [	MOVEI A,=100
01300			JRST IYDEF]
01400		CAIE C,12
01500		JRST [	CLRBFI
01600			JRST YINI1]
01700	IYDEF:	IMULI A,LBUFL+1
01800		MOVEM A,IYPOS#
01900		POP P,A
02000	XDEF:	MOVEM A,LINCNT#
02100		MOVEI B,-1(A)
02200		IMULI A,LBUFL+1
02300		MOVE T,JOBFF
02400		MOVEM T,XGPPTR
02500		SOS XGPPTR
02600		MOVEI T,2(A)		;2 EXTRA WORDS
02700		MOVNI TT,(T)
02800		ADD T,XGPPTR
02900		HRLM TT,XGPPTR
03000		MOVE TT,T
03100		CALLI T,11
03200		POPJ P,
03300		HRRZ L,XGPPTR
03400		MOVSI T,1(L)
03500		HRRI T,2(L)
03600		SETZM 1(L)
03700		MOVE U,JOBREL
03800		BLT T,(U)
03900		MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
04000		MOVEM TT,1(L)		;FIRST ONE HAS MARK AND CUT WITH IT
04100		TLZ TT,400000		;DELETE MARK AND CUT
04200		MOVEI T,1+LBUFL+1(L)
04300	XINL:	MOVEM TT,(T)
04400		ADDI T,LBUFL+1
04500		SOJG B,XINL
04600		MOVSI TT,400100
04700		MOVEM TT,(T)
04800		MOVE PEN,PENUP
04900		MOVE Y,IYPOS
05000		ADDI Y,2(L)
05100		MOVEI XD,DBUF+1
05200		SKIPL A,INIX		;WHERE DO WE START
05300		JRST MAYBON
05400		SUBI A,43
05500		IDIV A,[-44]
05600		HRLOI X,XD
05700		SOJA A,SETB
05800	
05900	MAYBON:	ADDI A,43
06000		IDIVI A,44
06100		CAILE A,LBUFL
06200		JRST OFFRT
06300		MOVE X,A
06400		SETZ A,
06500		HRLI X,Y
06600		JRST SETB
06700	
06800	OFFRT:	MOVE X,[XD,,LBUFL]
06900		SUBI A,LBUFL
07000	SETB:	MOVE B,INIX
07100		IDIVI B,44
07200		MOVSI B,400000
07300		MOVN C,C
07400		ROT B,(C)
07500	POPJ1:	AOS (P)
07600	CPOPJ:	POPJ P,
     

00100	XGPOUT:	OPEN XGP,[1017↔'XGP   '↔0]
00200		JRST NOXGP
00300		OUTSTR[ASCIZ/CRANKING XGP
00400	/]
00500		LOCK
00600	OUTIT:	OUT XGP,XGPPTR
00700		JRST OUTOK
00800	DSKERR:	PUSHJ P,DETCHK
00900		PUSHJ P,XERR
01000		PUSHJ P,ERRPNT
01100		ASCIZ /XGP OUTPUT ERROR.
01200	/
01300	OUTOK:	UNLOCK
01400		RELEAS XGP,
01500		JRST XMORE
01600	
01700	XMORE:	PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
01800		PUSHJ P,DETCHK
01900		JRST DODEL			;DELETE AUTOMATICALLY IF DETACHED
02000		OUTSTR[ASCIZ/DELETE .DMD FILE?/]
02100		INCHRW C
02200		CAIN C,15
02300		INCHRW C
02400		CAIE C,12
02500		OUTSTR[ASCIZ/
02600	/]
02700		CAIE C,"Y"
02800		CAIN C,"y"
02900		CAIA
03000		JRST NODEL
03100	DODEL:	MOVE A,[FILNAM,,LKENT]
03200		BLT A,LKENT+3
03300		INIT DSK,17
03400		'DSK   '
03500		0
03600		JRST [	SKIPGE DET
03700			PUSHJ P,XERR
03800			PUSHJ P,ERRPNT
03900			ASCIZ/COULDN'T GET DISK FOR DELETE!
04000	/
04100			JRST NODEL]
04200		LOOKUP DSK,LKENT
04300		JRST [	SKIPGE DET
04400			PUSHJ P,XERR
04500			PUSHJ P,ERRPNT
04600			ASCIZ/LOOKUP FOR DELETE FAILED!
04700	/
04800			JRST NODEL]
04900		MOVE A,FILPPN
05000		MOVEM A,LKENT+3
05100		SETZM LKENT
05200		RENAME DSK,LKENT
05300		CAIA
05400		JRST NODEL
05500		SKIPGE DET
05600		PUSHJ P,XERR
05700		PUSHJ P,ERRPNT
05800		ASCIZ/RENAME FOR DELETE FAILED!
05900	/
06000	NODEL:	RELEASE DSK,
06100		SKIPGE DET
06200		PUSHJ P,XERR
06300		PUSHJ P,ERRPNT
06400		ASCIZ/ALL DONE!
06500	/
06600		CALLI 12		;LEAVE
06700	
06800	NOXGP:	PUSHJ P,DETCHK
06900		PUSHJ P,XERR
07000		PUSHJ P,ERRPNT
07100		ASCIZ /XGP NOT AVAILABLE (I THOUGHT I WAS WAITING FOR IT)!
07200	/
07300		POPJ P,
07400	
07500	XGPPTR:	BLOCK 2
07600	
07700	IFN LSTBIT-1,<
07800	XFIX:	MOVE A,[LSTBIT-1]
07900		MOVE C,LINCNT
08000		HRRZ D,XGPPTR
08100	XFIXL:	ANDCAM A,LBUFL-1+2(D)
08200		ADDI D,LBUFL+1
08300		SOJG C,XFIXL
08400		POPJ P,
08500	>
08600	CORDWN:	MOVE T,JOBFF
08700		SUBI T,1
08800		CALLI T,11
08900		JRST 4,.
09000		POPJ P,
     

00100	FILNAM:	0
00200	FILEXT:	0
00300		0
00400	FILPPN:	0
00500	
00600	LKENT:	BLOCK 4
00700	
00800	XGSNAM:	0
00900	XGSEXT:	0
01000		0
01100	XGSPPN:	0
01200	
01300	IBUF:	BLOCK 3
01400	
01500	BITTAB:	FOR I←43,0,-1{1⊗I
01600	}
01700	BYTTAB:	FOR I←36,0,-6{REPEAT 6,{77⊗I}}
01800	
01900	DBUF:	BLOCK LBUFL+2
02000	
02100	PDL:	BLOCK LPDL
02200	
02300	END BEG